home *** CD-ROM | disk | FTP | other *** search
/ Input 64 / Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64 / editor .lsp < prev    next >
Text File  |  2023-02-26  |  4KB  |  126 lines
  1. (nx expr (lambda nil (cond ((atom (
  2. cdr clu))) (t (setq clu (cdr clu)) (
  3. setq cl (car clu))))))
  4. (find expr (lambda (l i x w) (cond ((
  5. atom l) nil) ((member i (car l)) (
  6. list x)) ((setq w (find (car l) i 1)) 
  7. (cons x w)) (t (find (cdr l) i (add1 
  8. x))))))
  9. (fi fexpr (nlambda (i) (mapc (quote g)
  10.  (find cl i 1 nil)) (p)))
  11. (b fexpr (nlambda l (rplaca clu (setq 
  12. cl (conc l (car clu)))) (back)) value 
  13. (a b (c d e) f g))
  14. (: fexpr (nlambda (l) (rplaca clu (
  15. setq cl l))))
  16. (lo expr (lambda (x y z) (setq z (nth 
  17. cl (h x))) (setq y (nth cl (h (sub1 x)
  18. ))) (cond ((consp (car z)) (rplacd y (
  19. car z))))))
  20. (li expr (lambda (x) (bi x -1)))
  21. (r fexpr (nlambda (x y) (repl x y cl))
  22. )
  23. (repl expr (lambda (x y l) (cond ((
  24. atom l) nil) ((equal (car l) x) (
  25. rplaca l y) (repl x y (cdr l))) ((
  26. equal (cdr l) x) (rplacd l y)) (t (
  27. repl x y (car l)) (repl x y (cdr l))))
  28. ))
  29. (ro expr (lambda (x y) (cond ((null y)
  30.  (setq y (length cl)))) (setq x (nth 
  31. cl (h x))) (setq y (nth cl (h y))) (
  32. rplaca x (conc (car x) (cdr x))) (
  33. rplacd x (cdr y)) (rplacd y nil)))
  34. (bo expr (lambda (x) (setq x (nth cl (
  35. h x))) (setq y (conc (car x) (cdr x)))
  36.  (rplaca x (car y)) (rplacd x (cdr y))
  37. ))
  38. (bi expr (lambda (x y) (cond ((null y)
  39.  (setq y x))) (setq x (nth cl (h x))) 
  40. (setq y (nth cl (h y))) (setq z (cdr 
  41. y)) (rplacd y nil) (rplaca x (cons (
  42. car x) (cdr x))) (rplacd x z)))
  43. (ri expr (lambda (x y) (setq x (nth 
  44. cl (h x))) (setq y (nth (car x) (h y))
  45. ) (setq z (cdr x)) (rplacd x (cdr y)) 
  46. (conc (cdr y) z) (rplacd y nil)))
  47. (expt expr (lambda (x y) (cond ((eq y 
  48. 0) 1) (t (times x (expt x (sub1 y)))))
  49. ))
  50. (e fexpr (nlambda (l) (print (eval l))
  51. ) value (nlambda (l) (print (eval l)))
  52. )
  53. (_ expr (lambda nil (setq clu (last 
  54. tr)) (setq tr (list clu)) (setq cl (
  55. car clu))))
  56. (n fexpr (nlambda l (conc cl l)))
  57. (a fexpr (nlambda l (rplacd clu (conc 
  58. l (cdr clu))) (back)) value (nlambda 
  59. l (rplacd clu (conc l (cdr clu))) (
  60. back)))
  61. (conc expr (lambda (l1 l2) (cond ((
  62. atom l1) l2) ((atom l2) l1) (t (nconc 
  63. l1 l2)))))
  64. (del expr (lambda (x l) (setq x (h x))
  65.  (cond ((atom cl) cl) ((zerop x) (
  66. rplaca clu (setq cl (conc l cl)))) ((
  67. eq x 1) (rplaca clu (setq cl (conc l (
  68. cdr cl))))) (t (rplacd (nth cl (sub1 
  69. x)) (conc l (nth cl (add1 x))))))))
  70. (undo expr (lambda nil (setq lis (
  71. copy old)) (setq clu (list lis)) (
  72. setq tr (list clu)) (setq cl (car clu)
  73. )))
  74. (out expr (lambda nil (save 8 
  75. "@0:editor.lsp" edfns)))
  76. (add fexpr (nlambda l (cond ((atom l) 
  77. edfns) (t (setq edfns (cons (car l) 
  78. edfns)) (apply (quote add) (cdr l)))))
  79. )
  80. (p@ expr (lambda nil (pp cl)))
  81. (back expr (lambda nil (cond ((atom (
  82. cdr tr)) cl) (t (setq clu (car tr)) (
  83. setq tr (cdr tr)) (setq cl (car clu)))
  84. )))
  85. (g expr (lambda (x) (setq x (h x)) (
  86. cond ((zerop x) (back)) ((greaterp x (
  87. length cl)) cl) (t (setq tr (cons clu 
  88. tr)) (setq clu (nth cl x)) (setq cl (
  89. car clu))))))
  90. (p expr (lambda nil (print (p& cl))) 
  91. value (lambda nil (print (p& cl))))
  92. (p& expr (lambda (l) (cond ((atom l) 
  93. l) (t (cons (p& (car l)) (mapcar (
  94. quote (lambda (x) (cond ((atom x) x) (
  95. t (quote &))))) (cdr l)))))))
  96. (h expr (lambda (x) (cond ((minusp x) 
  97. (setq x (abs (plus 1 x (length cl)))))
  98. ) (cond ((greaterp x (length cl)) (
  99. length cl)) (t x))))
  100. (edfns value (nx find fi b : lo li r 
  101. repl ro bo bi ri expt e _ n a conc 
  102. del undo out add p@ back g p p& h 
  103. edfns edit editf editv editp))
  104. (edit expr (lambda (l) (prog (old tr 
  105. cl clu e x lis) (setq old l) (setq 
  106. lis (copy l)) (setq clu (list lis)) (
  107. setq tr (list clu)) (setq cl (car clu)
  108. ) (p) loop1 (msg "*ed*: ") (setq e (
  109. readl)) loop2 (cond ((atom e) (go 
  110. loop1))) (setq x (car e)) (cond ((
  111. numberp x) (g x)) ((eq x (quote ok)) (
  112. return (car (last tr)))) ((eq x (
  113. quote pp)) (pp cl)) ((atom x) (eval (
  114. list x))) ((numberp (car x)) (del (
  115. car x) (cdr x))) (t (eval x))) (setq 
  116. e (cdr e)) (go loop2))))
  117. (editf fexpr (nlambda (f l) (cond ((
  118. setq l (apply (quote getdef) (list f))
  119. ) (eval (cons (car l) (cons (cadr l) (
  120. edit (cddr l)))))))))
  121. (editv fexpr (nlambda (f) (set f (
  122. edit (eval f)))))
  123. (editp fexpr (nlambda (a p) (putprop 
  124. a p (edit (getprop a p)))))
  125. nil
  126.